#!/usr/bin/perl -w # for syntax highlighting
package clreqd_modules;

#########################################################################
# This rountine takes DBTYPE and SQL and returns the matching rows,	#
# if a SELECT statement or OK|FAILED if other SQL.			#
#									#
# Makes use of ::msg, ::warning and ::error when needbe.		#
#									#
# No locking here since SQLite performs that.				#
#########################################################################

use cldb;
use clutils qw(to_bool);
use clstatdb;
use clmasterdefaults;
use Data::Dumper;

sub perform_adhoc_sql {
my %ARGS=@_;
my $f;
my $db=uc($ARGS{DBTYPE});
my $sql=$ARGS{SQL};
my $conn;
my $restart=0;
my $port=undef;
my $table=0;

	$table=to_bool($ARGS{TABLE}) if exists($ARGS{TABLE});
	$restart=to_bool($ARGS{RESTART}) if exists($ARGS{RESTART});
	$port=$ARGS{PORT} if exists($ARGS{PORT});
	if($db ne "CONFIG" && $db ne "STATUS") {
		return "ERROR Unknown DB type (should be 'config' or 'status').";
	}

	my %extra=();
	if(defined($port)) {
		$extra{PORT}=$port;
	}
	if($db eq "CONFIG") {
		$conn=new cldb("$::ENV{TRUECL_CFG}/config.db",%extra);
	} else {
		$conn=new clstatdb("$::ENV{TRUECL_CFG}/status.db",%extra);
	}
	if(!defined($conn)) {
		return "ERROR Unable to make connection to '$db' database.";
	}

	my $href;
	if($sql =~ /^\s*SELECT\s+/i) {
		$href=$conn->get_rows($sql);
		if(! @$href) {
			if(($conn->error)[0]==0) {
				return "ERROR No matching records!";
			}
			return "FAIL " . ($conn->error)[1];
		}
	} else {
		my $r=$conn->do($sql);
		if(!$r) {
			return "FAIL " . ($conn->error)[1];
		}
		::msg("restart2=$restart");
		if($restart) {
			$conn->abort();
		}
		return "OK";
	}

	#################################################################
	# It was a query that worked, so return any results...		#
	#################################################################

	if($restart) {
		::msg("restart3=$restart");
		$conn->abort();
	}
	my @F=(keys(%{$href->[0]}));
	if(! @F) {
		return "ERROR No matching records!";
	}
	if($table) {
		my @wids=();
		my @types=();
		push @wids,length($_) foreach(@F);
		push @types,'' foreach(@F);
		my $cf=0;
		for (@$href) {
			$cf=0;
			for my $field (@F) {
				my $y=$_->{$field};
				$y="" if !defined($y);
				$y =~ s/\n//g;
				if($y =~ /^\d+$/) {
					$types[$cf].='d'; # number
				} else {
					if(!length($y)) {
						$types[$cf].='B'; # text
					} else {
						$types[$cf].='t'; # blank
					}
				}
				my $l=length($y);
				$wids[$cf]=$l if $wids[$cf] < $l;
				$cf++;
			}
		}
		my $s="";
		my $s2="";
		$cf=0;
		for my $ww (@F) {
			if($types[$cf] =~ /^d+$/) {
				$s.=sprintf("%*s  ",$wids[$cf],$ww);
			} elsif($types[$cf] =~ /^B+$/) {
				$cf++;
				next; # blank, so skip
			} else {
				$s.=sprintf("%*s  ",-$wids[$cf],$ww);
			}
			$s2.= '=' x $wids[$cf];
			$s2.='  ';
			$cf++;
		}
		$s.="\n";
		$s2.="\n";
		my $t="";
		for (@$href) {
			$cf=0;
			for my $field (@F) {
				my $y=$_->{$field};
				$y="" if !defined($y);
				$y =~ s/\n//g;
				if($types[$cf] =~ /^d+$/) {
					$t.=sprintf("%*s  ",$wids[$cf],$y);
				} elsif($types[$cf] =~ /^B+$/) {
					$cf++;
					next; # blank, so skip
				} else {
					$t.=sprintf("%*s  ",-$wids[$cf],$y);
				}
				$wids[$cf]=$l if $wids[$cf] < $l;
				$cf++;
			}
			$t.="\n";
		}
		chomp $t;
		return "OK_RAWOUT\n$s$s2$t";
	}
	@F=sort(@F);
	$r=join("|",@F);
	for (@$href) {
		my @x=();
		my $field;
		for $field (@F) {
			my $y=$_->{$field};
			$y="" if !defined($y);
			$y =~ s/\n//g;
			push @x,$y;
		}
		$r.="\n" . join("|",@x);
	}
	return $r;
}

1;
